home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / test / testmatc.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  9.8 KB  |  357 lines  |  [TEXT/R*ch]
  1. (* testmatc.sml --- test the match compiler 1996-07-10, 1997-02-03 *)
  2.  
  3. fun check' f = (if f () then "OK" else "WRONG") handle _ => "EXN";
  4.  
  5. fun checkres1 f argres = 
  6.     check'(fn _ => List.all (fn (arg, res) => f arg = res) argres)
  7.  
  8. fun checkres2 f argres = 
  9.     check'(fn _ => List.all (fn (arg1, arg2, res) => f arg1 arg2 = res) argres)
  10. ;
  11.  
  12. (* Inexhaustive: *)
  13.  
  14. fun f1 ([], [])       = 111 
  15.   | f1 (x::xr, y::yr) = 222;        
  16.  
  17. fun f1c []      []      = 111 
  18.   | f1c (x::xr) (y::yr) = 222;        
  19.  
  20. val test1a = checkres1 f1 [(([], []), 111), (([7], [8]), 222)];
  21. val test1b = (f1 ([], [1]); "WRONG") handle Match => "OK" | _ => "WRONG"
  22. val test1c = (f1 ([2], []); "WRONG") handle Match => "OK" | _ => "WRONG"
  23.  
  24. val test2a = checkres2 f1c [([], [], 111), ([7], [8], 222)];
  25. val test2b = (f1c [] [1]; "WRONG") handle Match => "OK" | _ => "WRONG"
  26. val test2c = (f1c [2] []; "WRONG") handle Match => "OK" | _ => "WRONG"
  27.  
  28. (* Inexhaustive, with unused rules: *)
  29.  
  30. fun f2 ([], [])       = 111 
  31.   | f2 (x::xr, y::yr) = 222
  32.   | f2 ([], [])       = 333;
  33.  
  34. fun f2c []      []      = 111 
  35.   | f2c (x::xr) (y::yr) = 222
  36.   | f2c []      []      = 333;
  37.  
  38. val test3a = checkres1 f2 [(([], []), 111), (([7], [8]), 222)];
  39. val test3b = (f2 ([], [1]); "WRONG") handle Match => "OK" | _ => "WRONG"
  40. val test3c = (f2 ([2], []); "WRONG") handle Match => "OK" | _ => "WRONG"
  41.  
  42. val test4a = checkres2 f2c [([], [], 111), ([7], [8], 222)];
  43. val test4b = (f2c [] [1]; "WRONG") handle Match => "OK" | _ => "WRONG"
  44. val test4c = (f2c [2] []; "WRONG") handle Match => "OK" | _ => "WRONG"
  45.  
  46.  
  47. (* Constructors with span 1 *)
  48.  
  49. datatype 'a t = Uniq of 'a
  50.  
  51. fun fc1 (Uniq "slam") = "en"
  52.   | fc1 (Uniq "glyf") = "to"
  53.   | fc1 (Uniq x)      = x
  54.  
  55. val test5 = checkres1 fc1 [(Uniq "slam", "en"), 
  56.                (Uniq "glyf", "to"), 
  57.                (Uniq "mock", "mock")]
  58.  
  59.  
  60. (* Constructors with arity = 0 *)
  61.  
  62. fun berry (true,  false, _    ) = 111
  63.   | berry (false, _,     true ) = 222
  64.   | berry (_,     true,  false) = 333
  65.   | berry (false, false, false) = 444
  66.   | berry (true,  true,  true ) = 555;
  67.  
  68. val testberry = checkres1 berry
  69.     [((true, true, true), 555),
  70.      ((false, false, false), 444),
  71.      ((false, false, true), 222),
  72.      ((false, true, false), 333),
  73.      ((true, false, false), 111)];
  74.  
  75.  
  76. (* Constructors with arity > 0; see also lists *)
  77.  
  78. datatype t = A | B | C of int list
  79.  
  80. fun fcon (A,   B, C [] ) = 111
  81.   | fcon (A,   B, C [1]) = 222
  82.   | fcon (B,   B, _    ) = 333
  83.   | fcon (A,   A, A    ) = 444
  84.   | fcon (C[], A, A    ) = 555;
  85.  
  86. val test6a = 
  87.     checkres1 fcon [((C[], A, A), 555), 
  88.             ((A, A, A), 444), 
  89.             ((A, B, C[]), 111), 
  90.             ((A, B, C[1]), 222), 
  91.             ((B, B, C[]), 333), 
  92.             ((B, B, C[1]), 333), 
  93.             ((B, B, A), 333)];
  94.  
  95. val test6b = (fcon (C[1], A, A); "WRONG") handle Match => "OK" | _ => "WRONG";
  96. val test6c = (fcon (C[],  B, A); "WRONG") handle Match => "OK" | _ => "WRONG";
  97. val test6d = (fcon (C[],  A, B); "WRONG") handle Match => "OK" | _ => "WRONG";
  98.  
  99. (* Non-greedy constructors *)
  100.  
  101. (* ? *)
  102.  
  103.  
  104. (* Special constants: int, string, char, word, real *)
  105.  
  106. fun fi 101  = 111
  107.   | fi 102  = 222
  108.   | fi 101  = 333
  109.   | fi 104  = 444
  110.   | fi ~101 = 555;
  111.  
  112. val test10a = checkres1 fi [(104, 444), (102, 222), (101, 111), (~101, 555)];
  113. val test10b = (fi 100; "WRONG") handle Match => "OK" | _ => "WRONG"
  114. val test10c = (fi 103; "WRONG") handle Match => "OK" | _ => "WRONG"
  115. val test10d = (fi 105; "WRONG") handle Match => "OK" | _ => "WRONG"
  116.  
  117. fun fs "first"  = 111
  118.   | fs "second" = 222
  119.   | fs "first"  = 333
  120.   | fs "fourth" = 444;
  121.  
  122. val test11a = checkres1 fs [("fourth", 444), ("second", 222), ("first", 111)];
  123. val test11b = (fs ""; "WRONG") handle Match => "OK" | _ => "WRONG"
  124. val test11c = (fs "Fourth"; "WRONG") handle Match => "OK" | _ => "WRONG"
  125.  
  126. fun fc #"A" = 111
  127.   | fc #"B" = 222
  128.   | fc #"A" = 333
  129.   | fc #"D" = 444;
  130.  
  131. val test12a = checkres1 fc [(#"D", 444), (#"B", 222), (#"A", 111)];
  132. val test12b = (fc #"@"; "WRONG") handle Match => "OK" | _ => "WRONG"
  133. val test12c = (fc #"C"; "WRONG") handle Match => "OK" | _ => "WRONG"
  134. val test12d = (fc #"E"; "WRONG") handle Match => "OK" | _ => "WRONG"
  135. val test12e = (fc #"d"; "WRONG") handle Match => "OK" | _ => "WRONG"
  136.  
  137. fun fw 0wx101 = 111
  138.   | fw 0wx102 = 222
  139.   | fw 0wx101 = 333
  140.   | fw 0wx104 = 444;
  141.  
  142. val test13a = checkres1 fw [(0wx104, 444), (0wx102, 222), (0wx101, 111)];
  143. val test13b = (fw 0wx100; "WRONG") handle Match => "OK" | _ => "WRONG"
  144. val test13c = (fw 0wx103; "WRONG") handle Match => "OK" | _ => "WRONG"
  145. val test13d = (fw 0wx105; "WRONG") handle Match => "OK" | _ => "WRONG"
  146.  
  147. fun fr 101.0  = 111
  148.   | fr 102.5  = 222
  149.   | fr 101.0  = 333
  150.   | fr 104.8  = 444
  151.   | fr ~101.0 = 555;
  152.  
  153. val test14a = checkres1 fr [(104.8, 444), (102.5, 222), 
  154.                 (101.0, 111), (~101.0, 555)];
  155. val test14b = (fr 100.1; "WRONG") handle Match => "OK" | _ => "WRONG"
  156. val test14c = (fr 103.0; "WRONG") handle Match => "OK" | _ => "WRONG"
  157. val test14d = (fr 104.9; "WRONG") handle Match => "OK" | _ => "WRONG"
  158.  
  159.  
  160. (* Tuples --- unused rules *)
  161.  
  162. fun funit1 () = 111
  163.   | funit1 x  = 222;
  164.  
  165. fun funit2 {} = 111
  166.   | funit2 x  = 222;
  167.  
  168. val test20 = checkres1 funit1 [((), 111), ({}, 111)];
  169. val test21 = checkres1 funit2 [((), 111), ({}, 111)];
  170.  
  171.  
  172. (* Vectors *)
  173.  
  174. fun berryvec #[true,  false, _    ] = 111
  175.   | berryvec #[false, _,     true ] = 222
  176.   | berryvec #[_,     true,  false] = 333
  177.   | berryvec #[false, false, false] = 444
  178.   | berryvec #[]                    = 666
  179.   | berryvec #[true]                = 777
  180.   | berryvec #[true, true]          = 888
  181.   | berryvec #[true, true, true, true] = 999
  182.   | berryvec #[true,  true,  true ] = 555
  183.  
  184. val testberryvec = checkres1 berryvec
  185.     [(#[true, true, true], 555),
  186.      (#[false, false, false], 444),
  187.      (#[false, false, true], 222),
  188.      (#[false, true, false], 333),
  189.      (#[true, false, false], 111),
  190.      (#[], 666),
  191.      (#[true], 777),
  192.      (#[true, true], 888),
  193.      (#[true, true, true, true], 999)];     
  194.  
  195.  
  196. (* Ref patterns *)
  197.  
  198. fun fref1 (ref ()) = 111
  199.   | fref1 (ref x)  = 222;
  200.  
  201. val test30 = checkres1 fref1 [(ref (), 111), (ref {}, 111)];
  202.  
  203. fun fref2 (ref [117]) = 111
  204.   | fref2 (ref [x])   = x
  205.   | fref2 (ref _)     = 222;
  206.  
  207. val test31 = 
  208.     checkres1 fref2 [(ref [], 222), (ref [999], 999), (ref [117], 111)];
  209.  
  210.  
  211. (* Static exception constructors *)
  212.  
  213. (* Make a dynamic excon for testing purposes *)
  214.  
  215. local 
  216.     fun fabricate () = 
  217.     let exception A in A end
  218. in
  219.     val dynExcon = fabricate ()
  220. end
  221.  
  222. exception A and C and D;
  223. exception B = A;
  224.  
  225. fun fexc1 A = 1
  226.   | fexc1 B = 2
  227.   | fexc1 A = 3
  228.   | fexc1 C = 4;
  229.  
  230. val test40a = 
  231.     checkres1 fexc1 [(C, 4), (B, 1), (A, 1)];
  232.  
  233. val test40b = (fexc1 Div; "WRONG") handle Match => "OK" | _ => "WRONG";
  234. val test40c = (fexc1 D; "WRONG") handle Match => "OK" | _ => "WRONG";
  235. val test40d = (fexc1 (Fail "blah"); "WRONG") 
  236.               handle Match => "OK" | _ => "WRONG";
  237. val test40e = (fexc1 dynExcon; "WRONG") handle Match => "OK" | _ => "WRONG";
  238.  
  239.  
  240. exception I of int and R of real 
  241. exception Z = I;
  242.  
  243. fun fexc2 (I 7)    = 111
  244.   | fexc2 (R 1.2)  = 222
  245.   | fexc2 (I 8)    = 333
  246.   | fexc2 (R ~1.2) = 444
  247.   | fexc2 (Z 9)    = 555
  248.   | fexc2 (Fail s) = 666
  249.   | fexc2 (R ~1.2) = 777
  250.   | fexc2 (Z 8)    = 888
  251.   | fexc2 _        = 999;
  252.  
  253. val test41a = checkres1 fexc2 
  254.     [(I 7, 111), (I 6, 999), (Z 8, 333), (R 1.2, 222), (I 8, 333), 
  255.      (R ~1.2, 444), (I 9, 555), (Z 9, 555), (Z 0, 999), (Fail "baf", 666),
  256.      (A, 999), (Div, 999), (dynExcon, 999)];
  257.  
  258. (* Dynamic exception constructors, nullary *)
  259.  
  260. fun enclose42 () =
  261.     let 
  262.     exception A and C and D;
  263.     exception B = A;
  264.     
  265.     fun fexc11 A = 1
  266.       | fexc11 B = 2
  267.       | fexc11 A = 3
  268.       | fexc11 C = 4;
  269.         
  270.     val test42a = checkres1 fexc11 [(C, 4), (B, 1), (A, 1)];   
  271.     val test42b = (fexc11 Div; "WRONG") 
  272.                   handle Match => "OK" | _ => "WRONG";
  273.     val test42c = (fexc11 D; "WRONG") 
  274.                       handle Match => "OK" | _ => "WRONG";
  275.     val test42d = (fexc11 (Fail "blah"); "WRONG") 
  276.                   handle Match => "OK" | _ => "WRONG";
  277.     val test42e = (fexc11 dynExcon; "WRONG") 
  278.                       handle Match => "OK" | _ => "WRONG";
  279.     in [test42a, test42b, test42c, test42d, test42e] end;
  280.  
  281. val test42 = enclose42 ();
  282.  
  283.  
  284. fun enclose43 () =
  285.     let 
  286.     exception I of int and R of real 
  287.     exception Z = I;
  288.     
  289.     fun fexc22 (I 7)    = 111
  290.       | fexc22 (R 1.2)  = 222
  291.       | fexc22 (I 8)    = 333
  292.       | fexc22 (R ~1.2) = 444
  293.       | fexc22 (Z 9)    = 555
  294.       | fexc22 (Fail s) = 666
  295.       | fexc22 (R ~1.2) = 777
  296.       | fexc22 (Z 8)    = 888
  297.       | fexc22 _        = 999;
  298.         
  299.     val test43a = checkres1 fexc22 
  300.         [(I 7, 111), (I 6, 999), (Z 8, 333), (R 1.2, 222), (I 8, 333), 
  301.          (R ~1.2, 444), (I 9, 555), (Z 9, 555), (Z 0, 999), 
  302.          (Fail "baf", 666), (A, 999), (Div, 999), (dynExcon, 999)];
  303.     in test43a end;
  304.  
  305. val test43 = enclose43();
  306.  
  307.  
  308. (* Raising Bind *)
  309.  
  310. fun fbind xs =
  311.     let val [x] = xs in x end
  312.  
  313. val test50a = check'(fn _ => 117 = fbind [117]);
  314. val test50b = (fbind []; "WRONG") handle Bind => "OK" | _ => "WRONG";
  315. val test50c = (fbind [1,2]; "WRONG") handle Bind => "OK" | _ => "WRONG";
  316.  
  317.  
  318. (* And a user test *)
  319.  
  320. fun esc s =
  321.     case explode s of
  322.     []                  => 100
  323.       | #"\\" :: #"n"  :: _ => 101
  324.       | #"\\" :: #"t"  :: _ => 102
  325.       | #"\\" :: #"v"  :: _ => 103
  326.       | #"\\" :: #"b"  :: _ => 104
  327.       | #"\\" :: #"r"  :: _ => 105
  328.       | #"\\" :: #"f"  :: _ => 106
  329.       | #"\\" :: #"\\" :: _ => 107
  330.       | #"\\" :: #"?"  :: _ => 108
  331.       | #"\\" :: #"'"  :: _ => 109
  332.       | #"\\" :: #"\"" :: _ => 110
  333.       | #"\\" :: #"x"  :: _ => 111
  334.       | #"\\" :: _          => 112
  335.       | _                   => 113;
  336.  
  337. val test60a = checkres1 esc 
  338.     [("", 100), ("\\nbaf", 101), ("\\\"klam", 110), ("\\yrg", 112), 
  339.      ("abc", 113), ("\nbaf", 113)]
  340.  
  341. (* Proper compilation of irrefutable subpatterns *)
  342.  
  343. fun irr1 ((), 1) = 1 
  344.   | irr1 ((), _) = 2;
  345.  
  346. fun irr2 (#[], 1) = 3
  347.   | irr2 (#[], _) = 4
  348.   | irr2 (_, _) = 5;
  349.  
  350. fun irr3 (_, 1) = 6
  351.   | irr3 (_, _) = 7;
  352.  
  353. val test70 = 
  354.     irr1((), 1) = 1 andalso irr1((), 7) = 2
  355.     andalso irr2(#[], 1) = 3 andalso irr2(#[], 7) = 4 andalso irr2(#[1], 1) = 5
  356.     andalso irr3(68, 1) = 6 andalso irr3(78, 7) = 7;
  357.